perm filename FLIP[900,BGB] blob
sn#129568 filedate 1974-11-11 generic text, type T, neo UTF8
00100 TITLE FLIP
00200 EXTERNAL FIX1A,NUMVAL,CONS,FLONUM,MAKNUM,SQRT,ATAN,SIN,COS
00300 INTERNAL NOW,DRUMO,DRUMI,DRUMZ
00400 INTERNAL PFLIP,PSET,PZIP,PNOT,PXOR,PIOR,PAND,PEQU,PNOR
00500 INTERNAL LOGIC,HISTO,SIEVE,HISTOV
00600 INTERNAL PACK,XMINW,AREA,YMIN,YMAX,SUMY
00700 INTERNAL SUMSQY,SUMX,SUMSQX,PAC,STOPWAR,INARDS
00800 INTERNAL COLORS,TSINIT,LENS,SWS,ZIP,TV,TVADD,TVSUB,ADDC
00900 INTERNAL IMULC,GRAD,PAN,FOCUS,TILT,PPP,TTT,FFF,HISTOP
01000 INTERNAL DAC,ARM,JOINT,JOY,SEED,BLIT,XYFLIP
01100 INTERNAL BLOT,LSD
01200 OPDEF CALL[34B8]
01300 OPDEF JCALL[35B8]
01400 OPDEF SPCWAR[43B8]
01500 OPDEF OUTCHR[XWD 51040,0]
01600 OPDEF INUM[SUBI 3577777]
01700 OPDEF PTYGET[711B8]
01800 OPDEF PTWR1W[71134B14]
01900 OPDEF PTWRS7[71144B14]
02000 OPDEF PTSETL[711B11]
02100 OPDEF OUTSTR[5114B14]
02200 A←1
02300 B←2
02400 C←3
02500 D←4
02600 E←5
02700 F←6
02800 G←7
02900 H←10
03000 I←←4
03100 J←←5
03200 K←←6
03300 L←←7
03400 P←14
03500 NPAC←25
04600 ;HISTOGRAM VECTORS
04700 HISTOV: 0
04800 BLOCK 110
04900 ;PICTURE ACCUMULATORS
05000 PAC: 0
05100 BLOCK 220*NPAC
00100 ;VIDICON INPUT BUFFER
00200 TVBUF: 0
00300 BLOCK 1100
00350
00352 ;COLOR BYTE POINTERS
00354 CBPTR: POINT 9,COLORS,8
00356 POINT 9,COLORS,17
00358 POINT 9,COLORS,26
00360 POINT 9,COLORS,35
00400 BLOCK 110
00500 ;COLOR IMAGE ARITHMETIC AREA
00600 COLORS: 0
00700 BLOCK 110*110
00800 BLOCK 110
00900 WIDTH←←40
01000 XLOTV←←24
01100 XHITV←←XLOTV+WIDTH*11
01200 YLOTV←←24
01300 YHITV←←374
01400 VOLUME←←(YHITV-YLOTV)*WIDTH
01500
01600 PING: 0
01700 BCLIP: 7
01800 TCLIP: 0
01900 BITS: 4
02000 IWID: WIDTH*11
02100 LINLEN: WIDTH
02200 FLINE: YLOTV
02300 LLINE: YHITV-1
02400 LSIDE: XLOTV
02500 RSIDE: XHITV-1
02600 VOLUME
02700 DSKBUF: 0
02800 BLOCK WIDTH*440
02900
03000 CWI←<BYTE(9) XLOTV,YLOTV,4,4>
03200 ;CAMERA - WINDOWS.
03300 CWTV: CWI
03400 CWCOLR: CWI↔CWI↔CWI↔CWI
03500 CWPAC: FOR I←0,NPAC <CWI
03600 >
03800 ;SIEVE - BOUNDS.
03900 SBPAC: 0
04000 BLOCK NPAC
04100
04200 Q←577777
04400 ;(NOW) RETURNS TIME OF DAY IN 1/60'S OF A SECOND.
04500 NOW: CALLI 1,22
04600 JCALL 1,FIX1A
05000 PACPTR: FOR I←0,NPAC<I*220
05100 >
05200 PACPAC: FOR I←0,NPAC<PAC+I*220
05300 >
05400 FOR @$ I←0,NPAC<PAC$I←PAC+I*220
05500 >
05600
00100 ;BORROW TRIG FUNCTIONS FROM THE FORTRAN LIBRARY AND LINK TO LISP.
00200 DEFINE FUN (LTAG,FTAG)
00300 {
00400 LTAG: CALL 1,NUMVAL
00500 MOVEM A,ARG#
00600 JSR ACPUT
00700 JSA 16,FTAG
00800 JUMP 2,ARG
00900 MOVEM ARG
01000 JSR ACGET
01100 MOVE A,ARG
01200 MOVEI B,FLONUM
01300 JCALL 2,MAKNUM
01400 }
01500 FUN(SQR,SQRT)
01600 FUN(ARCTAN,ATAN)
01700 FUN(SINE,SIN)
01800 FUN(COSINE,COS)
00100 ;(TV Z)
00200 TV: CALL 1,NUMVAL
00300 MOVEM A,TVZ
00400 MOVEM A,PINGZ# ;SAVE CLIPS FOR PINGLE .DAT FILE OUTPUT.
00500
00600 MOVE A,[XWD -VOLUME,DSKBUF]
00700 MOVEM A,TVPTR
00800
00900 MOVE A,[BYTE(9)YLOTV,XLOTV,WIDTH]
01000 MOVEM A,TVYXW
01100
01200 JRST TAKETV
01300
01400 ;(TVWEE X Y Z)
01500 TVWEE: INUM 1,
01600 INUM 2,
01700 MOVEI 4,10B26
01800 DPB 1,[POINT 9,4,17] ;X
01900 DPB 2,[POINT 9,4,8] ;Y
02000 MOVEM 4,TVYXW
02100
02200 MOVE A,[XWD -1100,TVBUF]
02300 MOVEM A,TVPTR
02400
02500 MOVE 1,3
02600 CALL 1,NUMVAL
02700 MOVEM A,TVZ
02800 JRST TAKETV
02900
03000 ;TAKE A TV PICTURE, AND CONVERT GREY CODE.
03100 TAKETV: INIT 17,17
03200 SIXBIT/TV/
03300 0 ;NO BUFFERING
03400 JRST [OUTSTR [ASCIZ /CAN'T INIT TV./]↔SETZ 1,↔POPJ P,]
03500 SETZM TVERR
03600 INPUT 17,[
03700 TVPTR: XWD -VOLUME,DSKBUF
03800 TVZ: 0 ;BOTTOM CLIP, TOP CLIP, CAMERA, VERTICAL AND HORIZONTAL.
03900 TVYXW: BYTE(9)YLOTV,XLOTV,WIDTH
04000 TVERR: 0] ;ERRORS
04100
04200 MOVE A,TVERR
04300 TRNE A,100060
04400 JRST [TRNE A,100000
04500 OUTSTR [ASCIZ/TV PARITY ERROR.
04600 /]↔ TRNE A,40
04700 OUTSTR [ASCIZ/TV DATA MISS.
04800 /]↔ TRNE A,20
04900 OUTSTR [ASCIZ/TV NON EX MEM ERROR BIT.
05000 /]↔ JRST .+1]
00100 ;CONVERT GREY CODE.
00200 JSR ACPUT
00300 HRLZI 16,[
00400 SETCM 17,(16) ;0
00500 MOVE 15,17 ;1
00600 LSH 15,-1 ;2
00700 AND 15,13 ;3
00800 XORB 17,15 ;4
00900 LSH 15,-2 ;5
01000 AND 15,14 ;6
01100 XOR 17,15 ;7
01200 MOVEM 17,(16) ;10
01300 AOBJN 16, ;11
01400 JRST TVEXIT-1 ;12
01500 BYTE (4)7,7,7,7,7,7,7,7,7 ;13
01600 BYTE (4)3,3,3,3,3,3,3,3,3 ;14
01700 ]
01800 BLT 16,14
01900 MOVE 16,TVPTR
02000 JRST
02100
02200 JSR ACGET
02300 TVEXIT: CALLI 1,22
02400 MOVEM 1,TCLIP
02500 JCALL 1,FIX1A
02600
02700 ;(DISKO SERIES SERIAL)
02800 DISKO: LDB C,[POINT 3,PINGZ,20]
02900 MOVEM C,BCLIP
03000 LDB C,[POINT 3,PINGZ,23]
03100 MOVEM C,TCLIP
03200 TROA C,1
03300 ;(DISKI SERIES SERIAL)
03400 DISKI: SETZ C,
03500 DPB C,[POINT 1,DISK1,8]
03600 DPB C,[POINT 1,DISK2,8]
03700
03800 INUM A,
03900 INUM B,
04000 ROT B,-3*5
04100 FOR I←1,5{
04200 ROT A,3
04300 IORI A,2
04400 ROTC A,3}
04500 MOVEM A,[DSKNAM: 0↔SIXBIT/DAT/↔0↔0]
04600 SETZM DSKNAM+2↔SETZM DSKNAM+3↔HLLZS DSKNAM+1
04700
04800 INIT 3,17
04900 SIXBIT/DSK/
05000 0;NO BUFFERS
05100 JRST [OUTSTR [ASCIZ /DISK INIT FAILED./]↔SETZ 1,↔POPJ P,]
05200
05300 DISK1: LOOKUP 3,DSKNAM
05400 JRST [OUTSTR [ASCIZ /DISK FILENAME ERROR./]↔SETZ 1,↔POPJ P,]
05500
05600 DISK2: INPUT 3,[XWD -(VOLUME+13),PING ↔ 0]
05700 CLOSE 3,
05800 RELEASE 3,
05900 SETZ 1,
06000 POPJ P,
06100
06200 OPDEF DRUM[707B8]
06300 ;(DRUMO BAND SECTOR)
06400 DRUMO: TROA C,1
06500 ;(DRUMI BAND SECTOR)
06600 DRUMI: SETZ C,
06700 DPB C,[POINT 1,DRUMOP,8]
06800 INUM A,
06900 INUM B,
07000 ANDI A,37
07100 ANDI B,7
07200 IMULI B,460
07300 MOVEM B,SECTOR
07400 DRUMOP: DRUM A,[PING
07500 VOLUME+20
07600 SECTOR: 0]
07700 JRST [CALLI A,400011 ;RELEASE BAD BAND
07800 CALLI A,400010 ;GET A GOOD BAND
07900 JRST [OUTSTR [ASCIZ /DRUM BAND FAILURE.
08000 /]↔ JRST .+1]
08100 JRST .-1]
08200 SETZ 1,
08300 POPJ P,
08400
08500 ;(DRUMZ)
08600 DRUMZ: CALLI 400012
08700 SETZ 1,
08800 POPJ P,
00100 ;(WINDOW X Y DX DY)
00200 WINDOW: INUM A,
00300 INUM B,
00400 INUM C,
00500 INUM D,
00600 ;SET TVBUF'S CAMERA-WINDOW.
00700 MOVEM D,CWTV
00800 HRLM B,CWTV
00900 DPB A,[POINT 9,CWTV,8]
01000 DPB C,[POINT 9,CWTV,26]
01100 SUBI A,XLOTV
01200 SUBI B,YLOTV
01300 TVBPTR←←1
01400 DSKPTR←←2
01500
01600 JSR ACPUT
01700 MOVE A ;X/9 QUOTIENT IN 0
01800 IDIVI 11 ;X/9 REMAINDER IN 1
01900 IMULI DSKPTR,WIDTH
02000 ADDI DSKPTR,DSKBUF
02100 ADD DSKPTR, ;(Y*WIDTH) + (ADDR OF DSKBUF) + (QUOTIENT OF X/9)
02200
02300 MOVNS 1 ;FORM P&S BITS FROM REMAINDER OF X/9.
02400 ADDI 1,10
02500 ROT 1,16
02600 IORI 1,400 ; <POINT 4,ADDR,4*(REMAINDER OF X/9) >
02700
02800 HRRM 3,PMDX ;PROG MOD DX
02900
03000 IMULI 3,10 ;FORM DYGAP IN 4
03100 IMULI 4,WIDTH
03200 SUB 4,3
03400 MOVE [XWD[
03500 MOVEI 3,107 ;5 INNER LOOP COUNTER
03600 UNW1: LDB DSKPTR ;6 MEM-CYC FROM DSKBUF
03700 UNW2: IDPB TVBPTR ;7 MEM-CYC TO TVBUF
03800 PMDX: MOVEI ;10 DX-LOOP -PROG MOD DX
03900 IBP DSKPTR ;11
04000 SOJG 11 ;12
04100 SOJGE 3,6 ;13 LOOP-INNER
04200 HRLI DSKPTR, ;14 -PROG MOD ORIGINAL P&S BITS.
04300 ADDI DSKPTR, ;15 -PROG MOD DY GAP.
04400 SOJGE 4,5 ;16 LOOP-OUTER
04500 JRST [JSR ACGET↔SETZ 1,↔POPJ P,]],5]
04600 BLT 17
04700 HRR 14,1
04800 HRR 15,4
04900 MOVE TVBPTR,[POINT 4,TVBUF]
05000 MOVEI 4,107
05100 HRL DSKPTR,14
05200 JRST 5
00100 ;(UNWIND X Y DX DY)
00200 UNWIND: MOVE E,[ILDB TVBPTR]
00300 MOVEM E,UNW1
00400 MOVE E,[DPB DSKPTR]
00500 MOVEM E,UNW2
00600 PUSHJ P,WINDOW
00700 MOVE E,[LDB DSKPTR]
00800 MOVEM E,UNW1
00900 MOVE E,[IDPB TVBPTR]
01000 MOVEM E,UNW2
01100 POPJ P,
01200
01300
01400 ;(TVMOVE N)
01500 TVMOVE: MOVE B,CWTV ;CHANGE CAMERA WINDOW OF COLOR N.
01550 MOVEM B,CWCOLR-Q(A)
01575 MOVE A,CBPTR-Q(A)
01600 MOVE B,[POINT 4,TVBUF]
01700 MOVE C,[XWD[
01800 ILDB C,B ;5 GET FROM TVBUF
01900 DPB C,A ;6 PUT IN COLORS
02000 AOS A ;7
02100 SOJG D,5 ;10
02200 SETZ 1, ;11
02300 POPJ P, ;12
02400 ],5]
02500 BLT C,12
02600 MOVEI D,110*110
02700 JRST E
02800 ;(TVPACK N)
02900 TVPACK: MOVE A,CBPTR-Q(A)
03000 MOVE B,[POINT 4,TVBUF]
03100 MOVE C,[XWD[
03200 LDB C,A ;5 GET FROM TVBUF
03300 IDPB C,B ;6 PUT IN COLORS
03400 AOS A ;7
03500 SOJG D,5 ;10
03600 SETZ 1, ;11
03700 POPJ P, ;12
03800 ],5]
03900 BLT C,12
04000 MOVEI D,110*110
04100 JRST E
04200
04300
04400 ;(TVADD N)
04500 TVADD: MOVEM TEMP#
04600 MOVE A,CBPTR-Q(A)
04700 MOVE B,[POINT 4,TVBUF]
04800 MOVE C,[XWD[
04900 ILDB B ;5 GET FROM TVBUF
05000 LDB C,A ;6 GET FROM COLORS
05100 ADD C, ;7
05200 DPB C,A ;10 PUT IN COLORS
05300 AOS A ;11
05400 SOJG D,5 ;12
05500 JRST .+4 ;13
05600 ],5]
05700 BLT C,13
05800 MOVEI D,110*110
05900 JRST E
06000 MOVE TEMP
06100 SETZ 1,
06200 POPJ P,
06300
06400 ;(TVSUB N)
06500 TVSUB: MOVEM TEMP
06600 MOVE A,CBPTR-Q(A)
06700 MOVE B,[POINT 4,TVBUF]
06800 MOVE C,[XWD[
06900 ILDB B ;5 GET FROM TVBUF
07000 LDB C,A ;6 GET FROM COLORS
07100 SUB C, ;7
07200 DPB C,A ;10 PUT IN COLORS
07300 AOS A ;11
07400 SOJG D,5 ;12
07500 JRST .+4 ;13
07600 ],5]
07700 BLT C,13
07800 MOVEI D,110*110
07900 JRST E
08000 MOVE TEMP
08100 SETZ 1,
08200 POPJ P,
08300
00100 ;(LOGIC A B N)
00200 LOGIC: INUM C,
00300 MOVE A,[FOR I←0,NPAC< MOVE 11,PAC+I*220↔>]-Q(A)
00400 MOVE B,[FOR I←0,NPAC<SETZM 11,PAC+I*220↔>]-Q(B)
00500 DPB C,[POINT 4,B,6]
00600 MOVEI 10,217
00700 MOVE 11,[XWD[AOS 1↔AOS 2↔SOJGE 10,1↔SETZ 1,↔POPJ P,],3]
00800 BLT 11,7
00900 JRST 1
01000 DEFINE LOGOP (N) {
01100 MOVEI C,N
01200 JRST LOGIC+1}
01300 PFLIP: MOVE B,A ↔ LOGOP 12
01400 PSET: MOVE A,PACPAC-Q(A)
01500 SETOM 0(A)
01600 JRST PZIP+2
01700 PZIP: MOVE A,PACPAC-Q(A)
01800 SETZM 0(A)
01900 HRL A,A
02000 HRRZ B,A
02100 AOS A
02200 ADDI B,217
02300 BLT A,@B
02301 SETZ 1,
02302 POPJ P,
02351 AONLY: LOGOP 4
02375 BONLY: LOGOP 2
02400 PNOT: MOVE D,CWPAC-Q(A)
02450 MOVEM D,CWPAC-Q(B)
02475 LOGOP 12
02500 PXOR: LOGOP 6
02600 PIOR: LOGOP 7
02700 PAND: LOGOP 1
02800 PEQU: LOGOP 11
02900 BIMPA: LOGOP 15
02950 ABIMP: LOGOP 13
03000 PNOR: LOGOP 16
03100 NAND: LOGOP 10
03200 ;HISTOGRAMS FROM COLORS (HISTO N)
03300
03400 HISTO: INUM A,
03500 MOVNS A
03600 HLLI A,
03700
03800 SETZM HISTOV ;CLEAR HISTOGRAM VECTORS
03900 MOVE B,[XWD HISTOV,HISTOV+1]
04000 BLT B,HISTOV+107
04100
04200 MOVEI J,110*110-1
04300 MOVE B,COLORS(J) ;GET BYTES 0,1,2,3
04400 ROT B,@A
04500
04600 LDB C,[POINT 4,B,8] ;INCREMENT
04700 AOS HISTOV(C) ;COLOR 0
04800 LDB C,[POINT 4,B,17]
04900 AOS HISTOV+20(C) ;COLOR 1
05000 LDB C,[POINT 4,B,26]
05100 AOS HISTOV+40(C) ;COLOR 2
05200 ANDI B,17
05300 AOS HISTOV+60(B) ;COLOR 3
05400
05500 SOJGE J,.-12
05600
05700 SETZ A,
05800 POPJ P,
00100 ;(HISTOP PAC) ADDS TO HISTOGRAM FOR ONLY THE POINTS IN PAC
00200 HISTOP: MOVE A,PACPTR-Q(A)
00300 SETZM HISTOV ;CLEAR HISTOGRAM
00400 MOVE B,[XWD HISTOV,HISTOV+1]
00500 BLT B,HISTOV+107
00600 HRLI A,-217 ;LOOP COUNTER
00700 SETZ E, ;COLOR POINTER
00800
00900 MOVE C,PAC(A)
01000 MOVEI F,44
01100
01200 HISTP2: JFFO C,.+6
01300 ADD E,F
01400 AOBJN A,.-4
01500 SETZ A, ;EXIT
01600 MOVE F,TEMP
01700 POPJ P,
01800
01900 LSH C,@D
02000 ADD E,D
02100 SUB F,D
02200 MOVE B,COLORS(E) ;GET BYTES 0,1,2,3
02300 LDB D,[POINT 4,B,8] ;INCREMENT
02400 AOS HISTOV(B) ;COLOR 0
02500 LDB D,[POINT 4,B,17]
02600 AOS HISTOV+20(D) ;COLOR 1
02700 LDB D,[POINT 4,B,26]
02800 AOS HISTOV+40(D) ;COLOR 2
02900 ANDI B,17
03000 AOS HISTOV+60(D) ;COLOR 3
03100
03200 LSH C,1
03300 JRST HISTP2
00100 ;SET PAC FOR COLORS BETWEEN MIN AND MAX
00200 ;(SIEVE PAC COLOR MIN MAX)
00300 SIEVE: INUM A,
00400 INUM B,
00500 ANDI A,17
00600 ANDI B,3
00700 MOVE E,CWCOLR(B) ;CHANGE CAMERA WINDOW OF PAC.
00800 MOVEM E,CWPAC(A)
00900 MOVE F,PACPAC+1(A)
01000 MOVE E,PACPAC(A)
01100 HRRM E,SVEPAC
01200 INUM C,
01300 INUM D,
01400 HRRM C,SVEMIN
01500 HRRM D,SVEMAX
01600 MOVE A,CBP17(B)
01700 SETZM 0(E) ;CLEAR PAC.
01800 SOS F
01850 MOVEM F,SVEEND#
01900 HRLS E
02000 AOS E
02100 BLT E,@F
02200 JSR ACPUT
02300 MOVE [XWD .+3,2]
02400 BLT 17
02500 JRST 4
02600 ;0 BYTE
02700 ;1 A CBP(17)
02800 1 ;2 B BIT-MASK
02900 0 ;3 C PAC-WORD
03000 ROT B,-1 ;4
03100 LDB A ;5
03200 SVEMIN: CAIGE ;6
03300 JRST 12 ;7
03400 SVEMAX: CAIGE ;10
03500 TDO C,B ;11
03600 AOBJP 17,[MOVEM C,@SVEEND↔JSR ACGET↔SETZ 1,↔POPJ P,]
03700 CAIE B,1 ;13
03800 JRST 4 ;14
03900 SVEPAC: EXCH C,PAC ;15
04000 AOJA 15,4 ;16
04100 XWD -110*110,0 ;17 CBP-INDEX.
04200
04300 CBP17: POINT 9,COLORS(17),8
04400 POINT 9,COLORS(17),17
04500 POINT 9,COLORS(17),26
04600 POINT 9,COLORS(17),35
00100 ;(PACK PAC COLOR N)
00200 ;PACK PICTURE ACCUMULATOR INTO COLOR USING M
00300 PACK: MOVE D,PACPTR-Q(A)
00400 MOVE B,CBPTR-Q(B)
00500 INUM C,
00600 MOVEI F,217
00700 MOVEI E,43
00750 AOS D
00800 MOVE A,PAC(D)
00900 TLNE A,400000
01000 DPB C,B
01100 LSH A,1
01200 AOS B
01300 SOJGE E,.-4
01400 SOJGE F,.-10
01500 SETZ A,
01600 POPJ P,
00100 ;(BLOT PAC) INK-BLOT - KING'S MOVE.
00200 DEFINE BLTMAC (KEY){
00300 IFGE KEY,< IORM E,PAC-2(A) >
00400 IFGE KEY,< IORM F,PAC-1(A) >
00500 IORM E,PAC (A)
00600 IORM F,PAC+1(A)
00700 IFLE KEY,< IORM E,PAC+2(A) >
00800 IFLE KEY,< IORM F,PAC+3(A) >
00900 }
01100 BLOT: MOVE A,PACPTR-Q(A)
01200 HRLI A,20*220
01300 SETZM PAC20 ;CLEAR PAC 20
01400 MOVE B,[XWD PAC20,PAC20+1]
01500 BLT B,PAC20+217
01600 HRRZ B,A
01700 HRLI B,PAC20
01800 ADDI B,PAC ;RETURN BLIT'S AC.
01900 HRRZ C,B
02000 ADDI C,217 ;RETURN BLIT'S ADDR.
02100
02200 ;FIRST LINE.
02300 MOVE E,PAC (A) ;PICK UP OUT OF ARG PAC.
02400 MOVE F,PAC+1(A)
02500 MOVSS A
02600 BLTMAC -1
02700 MOVE G,E ↔ MOVE H,F
02800 LSHC E,1
02900 BLTMAC -1
03000 MOVE E,G ↔ MOVE F,H
03100 LSHC E,-1
03200 BLTMAC -1
03300 MOVSS A
03400
03500 MOVEI D,106 ;FORGET FIRST AND LAST LINES.
03600 BLOT1: ADD A,[XWD 2,2]
03700 MOVE E,PAC (A) ;PICK UP OUT OF ARG PAC.
03800 MOVE F,PAC+1(A)
03900 MOVSS A
04000 BLTMAC 0
04100 MOVE G,E ↔ MOVE H,F
04200 LSHC E,1
04300 BLTMAC 0
04400 MOVE E,G ↔ MOVE F,H
04500 LSHC E,-1
04600 BLTMAC 0
04700 MOVSS A
04800 SOJG D,BLOT1
04900
05000 ADD A,[XWD 2,2] ;LAST LINE.
05100 MOVE E,PAC (A) ;PICK UP OUT OF ARG PAC.
05200 MOVE F,PAC+1(A)
05300 MOVSS A
05400 BLTMAC 1
05500 MOVE G,E ↔ MOVE H,F
05600 LSHC E,1
05700 BLTMAC 1
05800 MOVE E,G ↔ MOVE F,H
05900 LSHC E,-1
06000 BLTMAC 1
06100 MOVSS A
06200
06300 BLT B,@C
06400 SETZ 1,
06500 POPJ P,
00100 ;(XMINW PAC)
00200 ;XMINIMUM AND WIDTH
00300 XMINW: MOVE A,PACPTR-Q(A)
00400 MOVEI C,107 ;LOOP COUNTER
00500 SETZB B,D
00600 IOR B,PAC(A)
00700 IOR D,PAC+1(A)
00800 ADDI A,2
00900 SOJGE C,.-3
01000
01100 JFFO B,.+6
01200 JFFO D,.+3
01300 MOVEI A,Q
01400 POPJ P, ;NOTHING RETURN
01500 ADDI E,44
01600 MOVE C,E
01700
01800 SETZ E, ;BIT COUNTER
01900 MOVN A,B
02000 TDZE B,A
02100 AOJA E,.-2
02200 MOVN A,D
02300 TDZE D,A
02400 AOJA E,.-2
02500 MOVE A,C
02600 ASH A,7
02700 IOR A,E
02800 ADDI A,Q ↔ POPJ P,
02900
03000 ;(AREA PAC)
03100 ;RETURNS A COUNT OF TH NUMBER OF POINTS IN A PICTURE
03200 AREA: MOVE A,PACPTR-Q(A)
03300 MOVEI B,217 ;LOOP COUNTER
03400 SETZ C, ;BIT COUNTER
03500 MOVE D,PAC(A)
03600 MOVN E,D ;MASK
03700 TDZE D,E
03800 AOJA C,.-2
03900 AOS A
04000 SOJGE B,.-5
04100 MOVE A,C
04200 ADDI A,Q ↔ POPJ P,
00100 ;(YMIN PAC)
00200 ;RETURNS LEAST Y-COORDINATE OF A POINT
00300 YMAX: MOVE C,PACPTR-Q(A)
00350 AOS A
00400 MOVE A,PACPTR-Q(A)
00500 MOVEI B,217
00600 SOS A
00700 SKIPN PAC(A)
00800 SOJGE B,.-2
00850 SUB A,C
00900 ASH A,-1
01000 ADDI A,Q ↔ POPJ P,
01100
01200 ;(YMAX PAC)
01300 ;RETRUN GREATEST Y-COORDINATE
01400 YMIN: MOVE A,PACPTR-Q(A)
01450 MOVE C,A
01500 MOVEI B,217
01600 SKIPE PAC(A)
01700 JRST .+3
01800 AOS A
01900 SOJGE B,.-3
01950 SUB A,C
02000 ASH A,-1
02100 ADDI A,Q ↔ POPJ P,
00100 ;(PAYROT PAC DY) PAC - Y - ROTATE.
00200 PAYROT: INUM B,
00300 MOVM C,B
00400 CAIL C,110
00500 JRST [IDIVI B,110↔EXCH B,C↔JRST .+1] ;MODULO 110 ROTATION
00600 HRLZ C,PACPAC-Q(A) ;HRLZ TWO COPIES OF PAC INTO TEMPORARIES.
00700 HRRI C,PAC23
00800 BLT C,PAC24-1
00900 HRLZ C,PACPAC-Q(A)
01000 HRRI C,PAC24
01100 BLT C,PAC25-1
01200 ASH B,1 ;2*DY
01300 HRLZ C,PACPAC-Q(A)
01400 HRRI C,PAC24
01500 SKIPGE B
01600 HRRI C,PAC23
01700 SUB C,B
01800 MOVSS C
01900 AOS A
02000 MOVE A,PACPAC-Q(A)
02100 SOS A ;LAST WORD IN PAC.
02200 BLT C,@A
02300 SETZ 1,
02400 POPJ P,
02500 ;(PAYSH PAC DY) PAC - Y - SHIFT.
02600 PAYSH: MOVE D,A
02700 MOVE A,PACPAC-Q(A)
02800 INUM B,
02900 HLR C,CWPAC-Q(D) ↔ ADD C,B ↔ HRLM C,CWPAC-Q(D)
03000 MOVM C,B
03100 CAIL C,110
03200 JRST PZIP+1 ;SHIFT LARGER THAN PAC HEIGHT.
03300 JUMPGE B,PAYSH2
03400 ;NEGATIVE DY SHIFT UP-SCREEN WHICH IS DOWN-CORE.
03500 HRLS A ;PAC,,PAC
03600 ASH C,1 ; 2*DY
03700 HRLZS C ; 2*DY,,0
03800 ADD A,C ; PAC+2*DY,,PAC or FROM,,TO-FIRST
03900 AOS D
04000 MOVE D,PACPAC-Q(D)
04100 MOVE E,D ;NEXT PAC
04200 MOVSS C ; 0,,2*DY
04300 SUB D,C ; 2*(110-DY)
04400 SOS D ; 2*(110-DY) - 1 or 0,,TO-LAST
04500 BLT A,@D ;MOVE BITS DOWN CORE.
04600 AOS D
04700 SETZM 0(D)
04800 HRLS D
04900 AOS D
05000 SOS E ;LAST WORD OF THIS PAC
05100 BLT D,@E ;CLEAR UP-CORE BITS WHICH IS THE BOTTOM OF THE PAC.
05200 SETZ 1,↔ POPJ P,
00100 ;POSITIVE DY
00200 PAYSH2: JUMPE B,.-2 ;NO SHIFTING.
00300 HRL C,A
00400 HRRI C,PAC23
00450 MOVE E,C
00500 BLT E,PAC24-1 ;MOVE PAC INTO PAC23
00600 MOVSS C
00700 ASH B,1
00900 ADD C,B ;FROM PAC23,,TO PAC+2*DY
01000 AOS D
01100 MOVE D,PACPAC-Q(D)
01200 SOS D ;LAST WORD OF THIS PAC
01300 MOVE E,C
01400 BLT E,@D ;MOVE BITS UP-CORE IN THE PAC.
01500 HRRZS C
01600 SOS C
01700 SETZM @A
01800 HRLS A
01900 AOS A
02000 BLT A,@C ;CLEAR TOP OF PAC
02100 SETZ 1,
02200 POPJ P,
02300 ;(PAXROT PAC DX) PAC - X -ROTATE.
02400 ;(PAXSH PAC DX) PAC - X - SHIFT.
02500 PAXROT: SKIPA C,[<ROTC>]
02600 PAXSH: MOVE C,[<LSHC>]
02700 MOVEM C,PAX2
02800 MOVEM AC0 ;SAVE AC 0
02900 INUM B,
02950 LDB C,[POINT 9,CWPAC-Q(A),8]
02975 ADD C,B
02987 DPB C,[POINT 9,CWPAC-Q(A),8]
03000 HRRM B,PAX2 ;DX COUNT.
03100 MOVE 2,PACPTR-Q(A) ;PAC POINTER.
03200 MOVEI 3,107 ;LOOP COUNTER.
03300 MOVE [XWD PAX3,4]
03400 BLT 13
03500 JRST 4
03600 PAX3: MOVE 0,PAC (2) ;4
03700 MOVE 1,PAC+1(2) ;5
03800 PAX2: ROTC 0,0 ;6
03900 MOVEM 0,PAC (2) ;7
04000 MOVEM 1,PAC+1(2) ;10
04100 ADDI 2,2 ;11
04200 SOJGE 3,4 ;12
04300 JRST PAX4 ;13
04400 PAX4: MOVE AC0
04500 SETZ 1,
04600 POPJ P,
04700 ;(PRISS PAC DXY)
04800 PRISS: MOVE D,A
04900 MOVE E,B
05000 PUSHJ P,PAYROT ;DOWN
05100 MOVE A,D
05200 INUM E,
05300 MOVN B,E
05400 ADDI B,Q ;AND TO THE RIGHT.
05500 PUSHJ P,PAXROT
05600 POPJ P,
05700 ;(PROSS PAC DXY)
05800 PROSS: MOVE D,A
05900 INUM B,
06000 MOVNS B
06100 ADDI B,Q
06200 MOVE E,B
06300 PUSHJ P,PAYROT ;UP
06400 MOVE A,D
06500 MOVE B,E
06600 PUSHJ P,PAXROT ;AND TO THE RIGHT.
06700 POPJ P,
00100 ;(SUMY PAC)(SUMSQY)
00200 SUMY: MOVEM TEMP
00300 MOVEM 6,TEM2#
00400 MOVE A,PACPTR-Q(A)
00500 MOVEI B,107 ;LOOP COUNTER
00600 SETZB 6,7
00700
00800 SUMY1: SETZ C,
00900 MOVE D,PAC(A)
01000 MOVN E,D
01100 TDZE D,E
01200 AOJA C,.-2
01300 MOVE D,PAC+1(A)
01400 MOVN E,D
01500 TDZE D,E
01600 AOJA C,.-2
01700 IMUL C,B
01800 ADD C
01900 IMUL C,B
02000 ADD 6,C
02100 ADDI A,2
02200 SOJGE B,SUMY1
02300 MOVE A,7
02400 EXCH 6,TEM2
02500 JCALL 1,FIX1A
02600 SUMSQY: MOVE 1,TEM2
02700 JCALL 1,FIX1A
00100 XHIST:
00200 BLOCK 110
00300 ;(SUMX PAC)(SUMSQX)
00400 SUMX: MOVE TEMP
00500 INUM A,
00600 ASH A,7
00700 SETZM XHIST
00800 MOVE B,[XWD XHIST,XHIST+1]
00900 BLT B,XHIST+107 ;CLEAR X HISTOGRAM
01000 MOVEI B,77 ;LOOP COUNTER
01100 SUMX1: SETZ E, ;X HISTOGRAM POINTER
01200 MOVE C,PAC(A)
01300 MOVE 0,PAC+1(A) ;PICKUP HORIZONTAL LINE
01400 SUMX2: JFFO C,.+2
01500 JRST SUMX3
01600 ADD E,D
01700 AOJ E,
01800 AOS XHIST(E)
01900 EXCH D,0
02000 LSHC C,1
02100 LSHC C,@0
02200 EXCH D,0
02300 JRST SUMX2
02400 SUMX3: JUMPE SUMX4
02500 ADDI E,44
02600 EXCH C,0
02700 JRST SUMX2
02800 SUMX4: ADDI A,2
02900 SOJGE B,SUMX1
03000 MOVEI A,107 ;XHIST POINTER
03100 SETZB B,C
03200
03300 MOVE D,XHIST(A) ;NUMBER OF POINTS AT
03400 JUMPE D,.+5
03500
03600 IMUL D,A ;VALUE X
03700 ADD B,D
03800 IMUL D,A ;SQUARED
03900 ADD C,D
04000
04100 SOJGE A,.-6
04200 MOVEM C,TEMP
04300 MOVE A,B
04400 JCALL 1,FIX1A
04500
04600 SUMSQX: MOVE A,TEMP
04700 JCALL 1,FIX1A
00100 ;GRADIENT
00200 ;RETURNS (DX↑2 + DY↑2)*2↑-4 IN COLOR 1
00300
00400 GRAD: MOVEI A,220*220-1
00500 MOVE B,COLORS(A)
00600 ANDI B,777
00700
00800 MOVE D,COLORS+1(A)
00900 ANDI D,777
01000 SUB D,B ;DELTA X
01100
01200 MOVE C,COLORS+110(A)
01300 ANDI C,777
01400 SUB C,B ;DELTA Y
01500
01600 IMUL C,C
01700 IMUL D,D ;SQUARED
01800
01900 ADD C,D
02000 ASH C,-4
02100
02200 ANDI C,777
02300 ROT C,9
02400
02500 IOR C,B
02600 HRRM C,COLORS(A)
02700
02800 SOJGE A,GRAD+1
02900 SETZ A,
03000 POPJ P,
03100
00100 ;COLOR ARITHMETIC OPERATION SUBGROUP.
00200 CBPTRB: POINT 9,COLORS-1(B),8
00300 POINT 9,COLORS-1(B),17
00400 POINT 9,COLORS-1(B),26
00500 POINT 9,COLORS-1(B),35
00600 ADDC: MOVEI C,(<ADD>)↔JRST IDIVC+1 ;(ADDC C1 C2)
00700 SUBC: MOVEI C,(<SUB>)↔JRST IDIVC+1 ;(SUBC C1 C2)
00800 IMULC: MOVEI C,(<IMUL>)↔JRST IDIVC+1 ;(IMULC C1 C2)
00900 IDIVC: MOVEI C,(<IDIV>) ;(IDIVC C1 C2)
01000 HRLM C,COLREX ;COLOR EXECUTION.
01100 JSR ACPUT
01200 MOVE C,CBPTRB-Q(A) ;FIRST BYTE POINTER
01300 MOVE D,CBPTRB-Q(B) ;SECOND BYTE POINTER.
01400 MOVEI B,110*110
01500 MOVE [XWD COLROP,5]
01600 BLT 17
01700 JRST 5
01800 ;0 TEMPORARY
01900 ;1 A TEMPORARY
02000 ;2 B COUNTER & INDEX
02100 ;3 C FIRST BYTE POINTER
02200 ;4 D SECOND BYTE POINTER
02300 COLROP: LDB 0,C ;5 FETCH FIRST BYTE.
02400 TRNE 0,400 ;6 EXTEND SIGN.
02500 IOR 0,17 ;7
02600 LDB 1,D ;10 FETCH SECOND BYTE.
02700 TRNE 1,400 ;11 EXTEND SIGN.
02800 IOR 1,17 ;12
02900 COLREX: ADD 1 ;13 EXECUTION
03000 DPB 0,C ;14 DEPOSIT
03100 SOJG B,5 ;15 LOOP
03200 JRST .+2 ;16 EXIT
03300 -1000 ;17
03400 JSR ACGET
03500 SETZ 1,
03600 POPJ P,
03700
03800 ;DOUBLE COLOR HALFWORD OP.
03900 DADDC: SKIPA 6,[<ADD A,B>] ;(DADDC C1 C2)
04000 DSUBC: MOVE 6,[<SUB A,B>] ;(DSUBC C1 C2)
04100 INUM A,
04200 INUM B,
04300 MOVE 4,[<HLRE A,COLORS-1(C)>]
04400 SKIPE A
04500 MOVE 4,[<HRRE A,COLORS-1(C)>]
04600 MOVE 5,[<HLRE B,COLORS-1(C)>]
04700 SKIPE B
04800 MOVE 5,[<HRRE B,COLORS-1(C)>]
04900 MOVE 7,[<HRLM A,COLORS-1(C)>]
05000 SKIPE A
05100 MOVE 7,[<HRRM A,COLORS-1(C)>]
05200 MOVEI C,110*110
05300 MOVE 10,[<SOJG C,4>]
05400 HRLZI 11,(<SETZ 1,>)
05500 HRLZI 12,(<POPJ P,>)
05600 JRST 4
05700 ;ACCUMULATORS:
05800 ;A
05900 ;B
06000 ;C INDEX & LOOP COUNTER
06100 ;4 HXRE A,COLORS-1(C)
06200 ;5 HYRE B,COLORS-1(C)
06300 ;6 ADD or SUB A,B
06400 ;7 HRXM A,COLORS-1(C)
06500 ;10 SOJG C,4
06600 ;11 SETZ 1,
06700 ;12 POPJ P,
06800
06900
07000 ;(MULC C1 C2)
07100 MULC: JSR ACPUT
07200 MOVE A,CBPTRB-Q(A)
07300 MOVEM A,AC1
07400 MOVE C,CBPTRB-Q(B)
07500 MOVEI B,110*110
07600 MOVE [XWD .+3,4]
07700 BLT 17
07800 JRST 4
07900 LDB 0,AC1 ;4
08000 TRNE 0,400 ;5
08100 IOR 0,[-1000] ;6
08200 LDB 1,C ;7
08300 TRNE 0,400 ;10
08400 IOR 1,[-1000] ;11
08500 IMUL 1 ;12
08600 DPB C ;13
08700 ASH -11 ;14
08800 DPB AC1 ;15
08900 SOJG B,4 ;16
09000 JRST .+1 ;17
09100 JSR ACGET
09200 SETZ 1,
09300 POPJ P,
09400
09500
09600 ;(DIVC C1 C2)
09700 DIVC: JSR ACPUT
09800 MOVE C,CBPTRB-Q(A)
09900 MOVE D,CBPTRB-Q(B)
10000 MOVEI B,110*110
10100 MOVE [XWD .+3,5]
10200 BLT 17
10300 JRST 5
10400 LDB 0,C ;5
10500 TRNE 0,400 ;6
10600 IOR 0,[-1000] ;7
10700 LDB 1,D ;10
10800 TRNE 1,400 ;11
10900 IOR 1,[-1000] ;12
11000 IDIV 1 ;13
11100 DPB 0,C ;14
11200 DPB 1,D ;15
11300 SOJG B,5 ;16
11400 JRST .+1 ;17
11500 JSR ACGET
11600 SETZ 1,
11700 POPJ P,
11800
11900
12000 ;MINOR ARITHMETIC SUBGROUP.
12100
12200 ;COLOR ARITHMETIC SHIFT LEFT N.
12300 ;(CASH COLOR N)
12400 CASH: MOVE A,CBPTRB-Q(A)
12500 INUM B,
12600 MOVE C,[XWD .+5,4]
12700 BLT C,13
12800 HRR 7,B
12900 MOVEI B,110*110
13000 JRST 4
13100 ;A POINTER
13200 ;B COUNTER
13300 ;C BYTE
13400 LDB C,A ;4
13500 TRNE C,400 ;5
13600 IOR C,13 ;6
13700 ASH C,0 ;7
13800 DPB C,A ;10
13900 SOJG B,4 ;11
14000 JRST .+2 ;12
14100 -1000 ;13
14300 SETZ 1,
14400 POPJ P,
14500
14600
14700
14800 ;(CABS COLOR)
14900 CABMSK: 1B0↔1B9↔1B18↔1B27
15000 ;COLOR ABSOLUTE VALUE.
15100 CABS: MOVE C,CABMSK-Q(A)
15200 MOVEI B,110*110
15300 MOVE A,CBPTRB-Q(A)
15400 JSR ACPUT
15500 MOVE [XWD .+3,4]
15600 BLT 15
15700 JRST 4
15800 ;0 TEMPORARY
15900 ;1 A POINTER
16000 ;2 B COUNTER
16100 ;3 C MASK
16200 TDNE C,COLORS-1(B) ;4
16300 JRST 10 ;5
16400 SOJG B,4 ;6
16500 JRST .+7 ;7
16600 LDB A ;10
16700 IOR 15 ;11
16800 MOVMS ;12
16900 DPB A ;13
17000 JRST 6 ;14
17100 -1000 ;15
17200 JSR ACGET
17300 SETZ 1,
17400 POPJ P,
17500
17600
17700
17800
17900 ;(ZIPALL) CLEAR ALL COLORS.
18000 ZIPALL: SETZM COLORS
18100 MOVE A,[XWD COLORS,COLORS+1]
18200 BLT A,COLORS+110*110-1
18300 SETZ A,
18400 POPJ P,
18500
18600
18700 ;(CZIP COLOR) CLEAR COLOR BYTE.
18800 CZIP: MOVE C,CBPTRB-Q(A)
18900 SETZ A,
19000 MOVEI B,110*110
19100 MOVE D,[<DPB A,C>]
19200 MOVE E,[<SOJG B,D>]
19300 HRLZI F,(<POPJ P,>)
19400 JRST D
19500
19600
19700
19800 ;(ZIPNEG COLOR) CLEAR ALL NEGATIVE INTENSITIES IN COLOR.
19900 ZIPNEG: MOVE D,CABMSK-Q(A)
20000 MOVE C,CBPTRB-Q(A)
20100 SETZ A,
20200 MOVEI B,110*110
20300 MOVE E,[<TDNE D,COLORS-1(B)>]
20400 MOVE F,[<DPB A,C>]
20500 MOVE G,[<SOJG B,E>]
20600 HRLZI H,(<POPJ P,>)
20700 JRST E
20800
20900
21000
21100 ;(CROUND COLOR N) V:=(V + 2**(N-1)) * 2**(-N)
21200 CROUND: MOVE D,CBPTRB-Q(A)
21300 INUM B,
21400 JSR ACPUT
21500 MOVE [XWD ROUND1,5]
21600 BLT 17
21700 MOVN A,B
21800 HRR 11,A
21900 SOS B
22000 MOVEI C,1
22100 ASH C,@B
22200 MOVEI B,110*110
22300 JRST 5
22400 ;0
22500 ;1 A TEMPORARY
22600 ;2 B INDEX
22700 ;3 C HALF
22800 ;4 D POINTER
22900 ROUND1: LDB A,D ;5
23000 TRNE A,400 ;6
23100 JRST 15 ;7
23200 ADD A,C ;10
23300 ASH A,0 ;11
23400 DPB A,D ;12
23500 SOJG B,5 ;13
23600 JRST .+4 ;14
23700 IOR A,[-1000] ;15
23800 SUB A,C ;16
23900 JRST 11 ;17
24000 JSR ACGET↔SETZ 1,↔POPJ P,
24100
24200
24300
24400 ;(CASHAL N) SHIFT ALL COLORS.
24500 CASHAL: INUM A,
24600 MOVE B,[XWD .+6,D]
24700 BLT B,10
24800 HRR E,A
24900 MOVEI C,110*110
24950 SETZ 1,
25000 JRST D
25100 MOVE B,COLORS-1(C) ;D
25200 ASH B, ;E
25300 MOVEM B,COLORS-1(C) ;6
25400 SOJG C,D ;7
25500 POPJ P, ;10
25600
25700 ;SCALAR INTEGER COLOR ARITHMETIC SUBGROUP.
25800 SICMUL: MOVEI C,(<IMUL>) ↔JRST SICADD+1 ;(SICMUL COLOR K)
25900 SICDIV: MOVEI C,(<IDIV>) ↔JRST SICADD+1 ;(SICDIV COLOR K)
26000 SICSUB: MOVEI C,(<SUB>) ↔JRST SICADD+1 ;(SICSUB COLOR K)
26100 SICADD: MOVEI C,(<ADD>) ;(SICADD COLOR K)
26200 HRLM C,SICEX
26300 MOVEM AC0
26400 MOVE D,CBPTRB-Q(A)
26500 INUM B,
26600 MOVE C,B ;SAFE KEEPING K
26700 MOVEI B,110*110
26800 MOVE [XWD .+3,5]
26900 BLT 13
27000 JRST 5
27100 LDB D ;5
27200 TRNE 400 ;6
27300 IOR [-1000] ;7
27400 SICEX: ADD C ;10 EXECUTE
27450 DPB D ;11
27500 SOJG B,5 ;12
27600 JRST .+1 ;13
27800 MOVE AC0
27900 SETZ 1,
28000 POPJ P,
00100 ;TV CAMERA SERVO INITIALIZAION
00200 TSINIT: MOVEI 1,11
00300 MOVE 1,STATUS
00400 SPCWAR 0,636367
00500 SPCWAR 1,TSERVO
00600 SETZ A,
00700 POPJ P,
00800
00900 ;READ SPACE WAR SWITCHES
01000 SWS: CALLI 1,400000
01100 ANDI 1,30377
01200 ;REVOLUTION-20000 QUARTER-10000
01300 JCALL 1,FIX1A
01400
01500 ;STOP SPACEWAR JOB
01600 STOPWAR: SPCWAR 0,636367
01700 SETZ A,
01800 POPJ P,
01900
02000 ;ADVANCE LENS TURRET
02100 LENS: MOVEI 1,14
02200 MOVEM 1,STATUS
02300 MOVE 1,STATUS
02400 TRNE 1,20
02500 HALT ;HUNG
02600 TRNN 1,1
02700 JRST .-4
02800 SETZ 1,
02900 POPJ P,
03000
03100 ;CLEAR COLORS
03200 ZIP: SETZM COLORS
03300 MOVE A,[XWD COLORS,COLORS+1]
03400 BLT A,COLORS+110*110-1
03500 SETZ A,
03600 POPJ P,
00100 FOCUS: INUM A,
00200 MOVEM 1,L1
00300 SETZB 1,STATUS
00400 POPJ P,
00500 PAN: INUM A,
00600 MOVEM 1,L3
00700 SETZB 1,STATUS
00800 POPJ P,
00900 TILT: INUM A,
01000 MOVEM 1,L2
01100 SETZB 1,STATUS
01200 POPJ P,
01300 FFF: MOVE A,P1
01400 ADDI A,Q ↔ POPJ P,
01500 PPP: MOVE A,P3
01600 ADDI A,Q ↔ POPJ P,
01700 TTT: MOVE A,P2
01800 ADDI A,Q ↔ POPJ P,
01900
02000
00100 ;(JOINT J X)
00200 ;MOVE JOINT J X INCREMENTS OR DECREMENTS
00300 JOINT: MOVEM B,C
00400 INUM A,
00500 EXCH A,C
00600 INUM A,
00700 ANDI C,7
00800 SOS C
00900 ADDM A,JOY(C)
01000 SETZ A,
01100 POPJ P,
01200 JOY: 0
01300 BLOCK 10
01400
01500 ;(ARM) START ARM SPACE WAR JOB
01600 ARM: SPCWAR 0,636367
01700 SPCWAR 1,DAC3
01800 SETZ A,
01900 POPJ P,
02000
02100 ;(DAC N Z) N=1 TO 7
02200 ;SET D TO A CONVERTER
02300 DAC: MOVEM B,C
02400 INUM A,
02500 EXCH A,C
02600 INUM A,
02700 ASH A,12
02800 ANDI C,7
02900 SOS C
03000 IOR A,C
03100 HRRM A,DAC3(C)
03200 SETZ A,
03300 POPJ P,
03400
00100 ;ARM SPACE WAR JOB
00200 DAC3: CONO 600,0 ;SET UP D TO A
00300 CONO 600,1
00400 CONO 600,2
00500 CONO 600,3
00600 CONO 600,4
00700 CONO 600,5
00800 CONO 600,6
00900
01000 MOVEI A,6 ;COUNT
01100 MOVEI B,20 ;BIT
01200 SETZ C, ;DATAO WORD TO BE
01300
01400 DAC4: SKIPN D,JOY(A)
01500 JRST DAC6
01600 IOR C,B ;NON-ZERO JOINT COUNT
01700 ROT B,1
01800 SKIPG D
01900 JRST DAC5
02000 ROT B,1 ;POSITIVE
02100 SOS JOY(A)
02200 JRST DAC6A
02300
02400 DAC5: IOR C,B ;NEGATIVE
02500 ROT B,1
02600 AOS JOY(A)
02700 JRST DAC6A
02800
02900 DAC6: ROT B,2 ;ZERO JOINT COUNT
03000 DAC6A: SOJGE A,DAC4
03100 MOVEM C,DAC8
03200 DATAO 420,DAC8
03300 HALT
03400 DAC8: 0
03500
00100
00200 ;PUT DOWN ACCUMULATORS 0,14,15,16,17.
00300 ACPUT: 0
00400 MOVEM AC0
00500 MOVE [XWD 14,AC14]
00600 BLT AC0+17
00700 MOVE AC0
00800 JRST @ACPUT
00900
01000 ;RESTORE ACCUMULATORS 0,14,15,16,17.
01100 ACGET: 0
01200 MOVE [XWD AC14,14]
01300 BLT 17
01400 MOVE AC0
01500 JRST @ACGET
01600
01700 AC0: 0
01800 AC1: 0
01900 AC2: 0
02000 AC3: 0
02100 AC4: 0
02200 AC5: 0
02300 AC6: 0
02400 AC7: 0
02500 AC10: 0
02600 AC11: 0
02700 AC12: 0
02800 AC13: 0
02900 AC14: 0
03000 AC15: 0
03100 AC16: 0
03200 AC17: 0
03300
00100 DH←←0
00200 DV←←1
00300 VI←←2
00400 HI←←3
00500 MM←←4
00600 ;(LSD PAC) LINE SEGMENT DETECTOR.
00700 LSD: MOVE A,PACPTR-Q(A)
00800 MOVEM A,LSDPTR#
00900
01000 ;CLEAR COLORS FOR TALLY ARRAY.
01100 SETZM COLORS
01200 MOVE B,[XWD COLORS,COLORS+1]
01300 BLT B,COLORS+110*110-1
01400
01500 ;PLACE INNERMOST LOOP OF LSD IN ACCUMULATORS.
01600 JSR ACPUT
01700 MOVE B,[XWD[
01800 ;0 DH OR PAC+1
01900 ;1 DV OR PAC
02000 ;2 VI OR X OR JFFO COUNT
02100 ;3 HI OR Y
02200 ;4 MM COUNTER FOR SLOPE LOOP.
02300 1B17 ;5 LEFT HALF ONE
02400 AOS COLORS(VI) ;6 HORIZONTAL TALLY.
02500 ADDM 5,COLORS(HI) ;7 VERTICAL TALLY.
02600 MOVSS HI ;10
02700 MOVSS VI ;11
02800 ADD HI,DH ;12
02900 ADD VI,DV ;13
03000 MOVSS HI ;14
03100 MOVSS VI ;15
03200 SOJG MM,6 ;16
03300 JRST LSD2 ;17
03400 ],5]
03500 BLT B,17
03600 HRREI 3,-1 ;INITIALIZE Y.
03700
03800 ;GET NEXT ROW OF PAC.
03900 LSD1: SETZB 2,LSDX ;CLEAR X.
04000 AOS 3 ;INCREMENT Y.
04100 MOVEM 3,LSDY
04200 MOVE 4,3
04300 LSH 4,1
04400 ADD 4,LSDPTR ;PAC POINTER.
04500 MOVE 0,PAC+1(4)
04600 MOVE 1,PAC+0(4)
04700 JRST LSD2B
00100 ;INITIALIZE INNER LOOP AND EXECUTE.
00200 LSD3: EXCH 1 ;SHIFT PAC ROW AND SAVE.
00300 LSHC @2 ↔ LSHC 1
00400 MOVEM LSDPAC+1
00500 MOVEM 1,LSDPAC
00600 ADDB 2,LSDX ;INCREMENT X.
00700
00800 ;HALFWORD RECIPRICOLS:
00900 ; 1,,10 =44* (3 * 4573) FOR ALMOST 1/44
01000 ; 0,,777777= 3*252525 FOR ALMOST 1/3
01100 ;AC0 DH = 110 - (X/44) FREE.
01200 ;AC1 DV = 110 - (Y/44) FREE.
01300 ;AC2 VI = ((X+Y) +107)/3 INITIALLY X.
01400 ;AC3 HI = ((Y+X) +107)/3 INITIALLY Y.
01500 ;AC4 MM = 110 FREE
01600 MOVN 0,2
01700 MOVN 1,3
01900 ADDB 2,3
02000 ADDI 2,107
02100 ADDI 3,107
02200 IMULI 2,252525
02300 IMULI 3,252525
02400 IMULI 0,4573
02500 IMULI 1,4573
02600 ADD 0,[XWD 110,0]
02700 ADD 1,[XWD 110,0]
02800 MOVEI MM,110
02850 MOVSS HI↔MOVSS VI
02900 JRST 6 ;EXECUTE ACCUMULATORS.
03000
03100 ;JFFO BIT FINDER.
03200 LSD2: MOVE 4,[XWD [LSDPAC: 0 ↔ 0
03300 LSDX: 0
03400 LSDY: 0 ],0]
03500 BLT 4,3
03600 LSD2B: JFFO 1,LSD3 ;FOUND A BIT.
03700 ;NO BIT IN FIRST WORD OF ROW.
03800 SKIPE 1,0 ;CHECK FOR ANY BITS IN 2ND WORD OF ROW.
03900 JRST [SETZ↔MOVEI 2,44↔ADDM 2,LSDX↔JRST LSD2B]
04000
04100 ;NEXT ROW ?
04200 CAIE 3,107
04300 JRST LSD1
04400 JSR ACGET ;ALL DONE.
04500 SETZ 1,
04600 POPJ P,
00100 ;(LOCMAX PACV PACH THRESHOLD)
00200 LOCMAX: MOVE A,PACPTR-Q(A)
00300 MOVE B,PACPTR-Q(B)
00400 ADD A,[POINT 1,PAC]
00500 ADD B,[POINT 1,PAC]
00600 INUM C,
00700 LOCMX0: MOVE D,[XWD -110*110,COLORS]
00800 SETO E,
00900
01400 DEFINE LMAXA (FETCH,BITPTR,LABEL) {
01500 FETCH F,0(D)
01600 CAMGE F,C
01700 JRST LABEL
01800 FETCH G, -111(D)↔CAMGE F,G↔JRST LABEL
01900 FETCH G, -110(D)↔CAMGE F,G↔JRST LABEL
02000 FETCH G, -107(D)↔CAMGE F,G↔JRST LABEL
02100 FETCH G, -1(D)↔CAMGE F,G↔JRST LABEL
02200 FETCH G, 1(D)↔CAMGE F,G↔JRST LABEL
02300 FETCH G, 107(D)↔CAMGE F,G↔JRST LABEL
02400 FETCH G, 110(D)↔CAMGE F,G↔JRST LABEL
02500 FETCH G, 111(D)↔CAMGE F,G↔JRST LABEL
02600 IDPB E,BITPTR
02700 SKIPA
02800 LABEL: IBP BITPTR }
02900
03000 LMAXA HLRZ,A,LOCMX1
03100 LMAXA HRRZ,B,LOCMX2
03200 AOBJN D,LOCMX0+1
03300 SETZ 1,
03400 POPJ P,
03500
03600 ;(PDOT PAC X Y)
03700 PDOT: MOVE A,PACPTR-Q(A)
03800 INUM B,
03900 INUM C,
04000
04100 JUMPL B,PDOT2 ;CHECK BOUNDS OF PAC.
04200 JUMPL C,PDOT2
04300 CAIL B,110
04400 JRST PDOT2
04500 CAIL C,110
04600 JRST PDOT2
04700
04800 ASH C,1
04900 ADD A,C
05000 CAIL B,44
05100 JRST [ SUBI B,44
05200 AOS A
05300 JRST .+1]
05400 MOVEI D,43
05500 SUB D,B ;BYTE POINTER P-FIELD.
05600 ROT D,-6
05700 IOR D,[POINT 1,PAC(1),35]
05800 SETO C,
05900 DPB C,D
06000 PDOT2: SETZ 1,
06100 POPJ P,
00100 ;(SEED PAC1 PAC2)
00200 ;MOVE ONE BIT FROM PAC1 INTO PAC2.
00300 SEED:
00350 MOVE C,CWPAC-Q(A) ;CHANGE CAMERA WINDOW OF PAC2
00375 MOVEM C,CWPAC-Q(B)
00387 MOVE A,PACPTR-Q(A)
00400 MOVE B,PACPTR-Q(B)
00500
00600 MOVEI C,217
00700 SKIPE D,PAC(A)
00800 JRST .+5
00900 AOS A
01000 SOJGE C,.-3
01100 SETZ A,
01200 POPJ P,
01300
01400 JFFO D,.+1
01500 MOVNS E
01600 HLLI E,
01700 HRLZI D,400000
01800 LSH D,@E
01900 SUBI C,217
02000 SUB B,C
02100 MOVEM D,PAC(B)
02200 SETZ A,
02300 POPJ P,
02400
02500
02600
02700
02800
02900 ;MOVE PAC1 INTO PAC2
03000 ;(BLIT PAC1 PAC2)
03100 BLIT: MOVE C,CWPAC-Q(A) ;CHANGE CAMERA WINDOW OF PAC2.
03150 MOVEM C,CWPAC-Q(B)
03175 HRLZ A,PACPTR-Q(A)
03200 HRR A,PACPTR-Q(B)
03300 ADD A,[XWD PAC,PAC]
03400 HRRZ B,A
03500 ADDI B,217
03600 BLT A,@B
03700 SETZ A,
03800 POPJ P,
03900
04000 ;(BORDER PAC)
04100 BORDER: MOVE A,PACPTR-Q(A)
04200 SETOM PAC (A)
04300 SETOM PAC+1 (A)
04400 SETOM PAC+216(A)
04500 SETOM PAC+217(A)
04600 HRRZI B,1
04700 MOVEM B,PAC+3(A)
04800 ROT B,-1
04900 MOVEM B,PAC+2(A)
05000 HRRZ B,A
05100 ADDI B,PAC+215
05200 HRL A,A
05300 ADD A,[XWD PAC+2,PAC+4]
05400 BLT A,@B
05500 SETZ A,
05600 POPJ P,
05700 ;(INTIOR PAC)
05800 INTIOR: MOVE A,PACPTR-Q(A)
05900 SETZM PAC (A)
06000 SETZM PAC+1 (A)
06100 SETZM PAC+216(A)
06200 SETZM PAC+217(A)
06300 HRREI B,-2
06400 MOVEM B,PAC+3(A)
06500 ROT B,-1
06600 MOVEM B,PAC+2(A)
06700 HRRZ B,A
06800 ADDI B,PAC+215
06900 HRL A,A
07000 ADD A,[XWD PAC+2,PAC+4]
07100 BLT A,@B
07200 SETZ A,
07300 POPJ P,
00100 ;(XYFLIP PAC)
00200 ;FLIPS THE CONTENTS OF PAC ABOUT THE X=Y AXIS
00300 XYFLIP: MOVE A,PACPTR-Q(A)
00301 MOVE E,CWPAC(A)
00302 MOVEM E,CWPAC+20
00400 MOVE E,A
00500
00600 ADD A,[POINT 1,PAC]
00700 MOVE B,[POINT 1,PAC20(C)]
00800 MOVEI D,107
00900 XYF0: HRLZI C,-110
00950 IBP B
01000 XYF1: ILDB F,A ;FROM PAC
01100 DPB F,B ;TO PAC 20
01200 AOS C
01300 AOBJN C,XYF1
01400 SOJGE D,XYF0
01401 SKIPE BLBFLG
01402 POPJ P, ;BLOB CALL EXIT.
01500
01600 ;MOVE PAC 20 TO PAC IF NOT A CALL FROM BLOB SUBR.
01601
01700 ADD E,[XWD PAC+20*220,PAC]
01800 HRRZ B,E
01900 ADDI B,217
02000 BLT E,@B
02100 SETZ A,
02200 POPJ P,
00100 ;(PACO PAC AW FLG) CW-PARAMETER AUTOMATED 1/2/70.
00200 ;DISPLAY PAC ON ARDS
00300 ;CW CAMERA WINDOW (CDX CX CDY CY) DEFAULT PAC'S CAMERA WINDOW
00400 ;AW ARDS WINDOW (ADX AX ADY AY) DEFAULT (4 -1120 -4 1000)
00500
00600 ;DISPLAY WINDOW TRANSFORM
00700 ;AX + (CX + X * CDX)*ADX
00800 ;AY + (CY + Y * CDY)*ADY
00900
01000 ;(AX+CX*ADX) + X*(CDX * ADX)
01100 ;(AY+CY*ADY) + Y*(CDY * ADY)
01200
01300 ;INITIALIZATION FROM ARGUMENTS
01400 PACO: MOVEM C,BLBFLG#
01500 ;XYFLIP ON FLAG.
01600 JUMPN C,[ MOVEM B,AC2
01700 PUSHJ P,XYFLIP
01800 MOVEI A,Q+20
01900 MOVE B,AC2
02000 JRST .+1]
02100 MOVEM B,C
02200 INUM A,
02300 MOVE B,A
02400 IMULI A,220
02500 HRLI A,-220
02600 CAIGE C,Q+40
02700 JRST [SKIPN C
02800 JRST [SKIPN BLBFLG
02900 MOVE C,AWNIL1↔JRST .+1
03000 MOVE C,AWNIL2↔JRST .+1]
03050 CAIGE C,Q-10 ↔ JRST .+1
03100 INUM C,
03200 MOVE C,AWTABL(C)
03300 JRST .+1]
03400
03500 LDB D,[POINT 9,CWPAC(B),26] ;CDX
03600 HLRZ E,@C
03700 INUM E,
03800 IMUL D,E
03900 MOVEM D,DDX#
04000 IMULI D,44
04100 MOVEM D,DDX44#
04200
04300 HRRZ C,@C
04400 LDB D,[POINT 9,CWPAC(B), 8] ;CX
04500 SUBI D,XLOTV
04600 HLRZ F,@C ;AX
04700 INUM F,
04800
04900 IMUL D,E ;CX *ADX
05000 ADD D,F
05100 MOVEM D,XORG#
05200
05300 HRRZ C,@C
05400 LDB D,[POINT 9,CWPAC(B),35] ;CDY
05500 HLRZ E,@C ;ADY
05600 INUM E,
05700 MOVE F,E
05800 IMUL F,D ;DDY
05900
06000 HRRZ C,@C
06100 LDB B,[POINT 9,CWPAC(B),17] ;CY
06200 SUBI B,YLOTV
06300 HLRZ C,@C ;AY
06400 INUM C,
06500 IMUL B,E
06600 ADD B,C
06700 SKIPE BLBFLG
06800 EXCH B,XORG
06900 MOVEM B,YORG#
07000 SKIPE BLBFLG
07100 MOVNS XORG
07200 SKIPE BLBFLG
07300 MOVNS YORG
00100 ;SCAN THRU PAC FOR NON-ZERO WORDS
00200 SKIPN B,PAC(A)
00300 BLB1: JRST [ AOBJN A, [ TLNN A,1
00400 ADDM F,YORG
00500 JRST .-1]
00600 SETZM BLBFLG
00700 HRREI E,-1200
00800 HRREI D,-1100
00900 PUSHJ P,ADOT
01000 SETZ A,
01100 MOVE F,TEMP
01200 CLOSE 7,
01300 POPJ P,]
01400
01500 ;DISPLAY DOT AS AN ORIGIN FOR NON-ZERO WORD
01600 ;XORG+(PARITY OF A LEFT)*44*DDX , YORG
01700 SETZ E,
01800 TLNE A,1
01900 MOVE E,DDX44 ;ODD PARITY RIGHT SIDE
02000 ADD E,XORG
02100 MOVE D,YORG
02200 PUSHJ P,ADOT
02300
02400 ;PUT SECOND WORD IN D
02500 SETZ D,
02600 TLNE A,1
02700 JRST .+3
02800 AOBJN A,.+1 ;EVEN PARITY
02900 MOVE D,PAC(A)
03000
03100 ;FIND AND DISPLAY BITS IN A LINE
03200 BLB2: JFFO B,BLB3
03300 SKIPN D ;NOTHING IN FIRST WORD
03400 JRST @BLB1 ;ALL DONE WITH THIS LINE
03500 SETZ C, ;FIND BITS IN SECOND WORD
03600 JFFO D,.+1
03700 LSH D,@E
03800 MOVE B,D
03900 ADDI E,44
04000 JRST BLB4
04100
04200 ;SPACE OVER ZERO BITS
04300 BLB3: JUMPE C,BLB5 ;NO SPACES
04400 EXCH C,D
04500 LSHC B,@D
04600 MOVE E,D
04700 BLB4: IMUL E,DDX
04800 SETZ D,
04900 PUSHJ P,NVEC
05000 MOVE D,C ;PUT SECOND WORD IN D AGAIN
00100 ;VECTOR DISPLAY
00200 ;LEADING ONES ARE IN B, SECOND WORD IN D.
00300 BLB5: MOVE C,D
00400 SETCM D,B ;FIND LENGTH OF VECTOR
00500 JFFO D,[LSHC B,@E ↔ JRST BLB6]
00600 ;FIRST WORD WAS SOLID ONES
00700 SETCM D,C ;GET SECOND WORD
00800 JFFO D,.+2
00900 MOVEI E,44 ;SECOND WORD WAS SOLID ONES TOO
01000 MOVE B,C ;ADVANCE THE BITS
01100 LSH B,@E
01200 SETZ C,
01300 ADDI E,44
01400 ;DISPLAY VECTOR OF LENGTH FROM E
01500 BLB6: IMUL E,DDX
01600 SETZ D,
01700 PUSHJ P,AVEC
01800 MOVE D,C
01900 JRST BLB2
02100 ;(ARDDOT X Y)
02200 ARDDOT: INUM A,
02300 INUM B,
02400 MOVE E,A
02500 MOVE D,B
02600 PUSHJ P,ADOT
02700 SETZ 1,
02800 POPJ P,
02900 ;(ARDVEC X Y)
03000 ARDVEC: INUM A,
03100 INUM B,
03200 MOVE E,A
03300 MOVE D,B
03400 PUSHJ P,AVEC
03500 SETZ 1,
03600 POPJ P,
03700 ;(ARDEOF)
03800 ARDEOF: CLOSE 7,
04000 SETZ 1,
04100 POPJ P,
04200 ;(ARDNVC X Y)
04300 ARDNVC: INUM A,
04400 INUM B,
04500 MOVE E,A
04600 MOVE D,B
04700 PUSHJ P,NVEC
04800 SETZ 1,
04900 POPJ P,
05000 ;(ARDFF)
05100 ARDFF: MOVEI E,14
05200 JSR PUTCHR
05300 SETZ 1,
05400 POPJ P,
05500
05600 XDX←←3
05700 YDY←←3
05800 X0← -1100
05900 X1← -440
06000 X2← 0
06100 X3← 440
06200
06300 X4←X0-2*XDX
06400 X5←X1- XDX
06500 X6←X2
06600 X7←X3+XDX
06700
06800 Y0←1200
06900 Y1← 540
07000 Y2← 100
07100 Y3 ←-340
07200
07300 Y4←Y0+2*YDY
07400 Y5←Y1+ YDY
07500 Y6←Y2
07600 Y7←Y3-YDY
07700
07800 ;ARDS-WINDOW LIST
07900 DEFINE AWLIST(X,Y,D){
08000 [XWD Q+D,[XWD Q+X,[XWD Q-D,[XWD Q+Y,0]]]]
08400
08500 }
08600
08700 AWLIST X4,Y4,2
08800 AWLIST X6,Y4,2
08900 AWLIST X4,Y6,2
09000 AWLIST X6,Y6,2
09100 AWLIST X0,Y0,2
09200 AWLIST X2,Y0,2
09300 AWLIST X0,Y2,2
09400 AWLIST X2,Y2,2
09500 AWTABL: AWLIST X0,Y0,1
09600 AWLIST X1,Y0,1
09700 AWLIST X2,Y0,1
09800 AWLIST X3,Y0,1
10000 AWLIST X0,Y1,1
10100 AWLIST X1,Y1,1
10200 AWLIST X2,Y1,1
10300 AWLIST X3,Y1,1
10500 AWLIST X0,Y2,1
10600 AWLIST X1,Y2,1
10700 AWLIST X2,Y2,1
10800 AWLIST X3,Y2,1
11000 AWLIST X0,Y3,1
11100 AWLIST X1,Y3,1
11200 AWLIST X2,Y3,1
11300 AWLIST X3,Y3,1
11400 AWLIST X4,Y4,1
11500 AWLIST X5,Y4,1
11600 AWLIST X6,Y4,1
11700 AWLIST X7,Y4,1
11800 AWLIST X4,Y5,1
11900 AWLIST X5,Y5,1
12000 AWLIST X6,Y5,1
12100 AWLIST X7,Y5,1
12200 AWLIST X4,Y6,1
12300 AWLIST X5,Y6,1
12400 AWLIST X6,Y6,1
12500 AWLIST X7,Y6,1
12600 AWLIST X4,Y7,1
12700 AWLIST X5,Y7,1
12800 AWLIST X6,Y7,1
12900 AWLIST X7,Y7,1
13000 ;TVBUF -5
13100 ;COLORS (-1,3)(-2,2)(-3,1)(-4,0)
13200 ;PAC 0 THRU 25
13300 ;CAMERA WINDOW GET. (CWGET N).
13400 CWGET: MOVE A,CWPAC-Q(A)
13500 JCALL 1,FIX1A
13600 ;CAMERA WINDOW PUT.
13700 ;(CWPUT X Y DX DY N)
13800 CWPUT: INUM A,
13900 INUM B,
14000 INUM C,
14100 INUM D,
14200 INUM E,
14300 MOVEM D,CWPAC(E)
14400 HRLM B,CWPAC(E)
14500 DPB A,[POINT 9,CWPAC(E),8]
14600 DPB C,[POINT 9,CWPAC(E),26]
14700 SETZ 1,
14800 POPJ P,
00100 ;(ZOOM PAC P Q dx dy)
00200 ;CALLS (WINDOW PACX+P*DX-44*dx PACY+Q*DY-44*dy dx dy)
00300 ZOOM: INUM A,
00400 INUM B, ;P
00500 INUM C, ;Q
00600 INUM D, ;dx
00700 INUM E, ;dy
00800 LDB 10,[POINT 9,CWPAC(A),26] ;DX
00900 LDB 11,[POINT 9,CWPAC(A),35] ;DY
01000 IMUL B,10 ;P*DX
01100 IMUL C,11 ;Q*DY
01200 MOVE 12,D
01300 MOVE 13,E
01400 IMULI D,44 ; 44*dy
01500 IMULI E,44 ; 44*dy
01600 LDB F,[POINT 9,CWPAC(A),8] ;PACX
01700 LDB G,[POINT 9,CWPAC(A),17] ;PACY
01800 ADD F,B
01900 ADD G,C
02000 SUB F,D
02100 SUB G,E
02200 MOVE A,F ;X
02300 MOVE B,G ;Y
02400 MOVE C,12 ;dx
02500 MOVE D,13 ;dy
02600 CAIGE A,XLOTV
02700 MOVEI A,XLOTV
02800 CAIGE B,YLOTV
02900 MOVEI B,YLOTV
03000 JRST WINDOW+4
03100
03200
03300 AWNIL1: AWLIST -1111,1224,4
03400 AWNIL2: AWLIST -1111,1200,4
00100 ;ARDS DRIVER FOR BLOB DISPLAY
00200 ;ARGUMENTS X & Y IN ACCUMULATORS E & D RESPECTIVELY.
00300 ADOT: EXCH E,[35]↔JSR PUTCHR↔EXCH E,[35]
00400 HLLZS CHRCON
00500 SKIPE BLBFLG
00600 JRST [MOVNS D ↔ MOVNS E ↔ EXCH D,E ↔ JRST .+1] ;X - Y - FLIP
00700 HRL D,E
00800 PUSHJ P,ARDS
00900 EXCH E,[36]↔JSR PUTCHR↔EXCH E,[36]
01000 POPJ P,
01100 NVEC: HLRS CHRCON
01200 SKIPA
01300 AVEC: HLLZS CHRCON
01400 SKIPE BLBFLG
01500 JRST [MOVNS D ↔ MOVNS E ↔ EXCH D,E ↔ JRST .+1] ; X - Y - FLIP
01600 CAIL D,2000
01700 JRST ARD2
01800 CAIL E,2000
01900 JRST ARD2
02000 CAMG D,[-2000]
02100 JRST ARD2
02200 CAMG E,[-2000]
02300 JRST ARD2
02400 HRL D,E
02500 PUSHJ P,ARDS
02600 POPJ P,
02700 ;VECTOR TOO LONG FOR ONE ARDS-VECTOR
02800 ARD2: MOVEM E,TEMPX#
02900 MOVEM D,TEMPY#
03000 ASH E,-1
03100 ASH D,-1
03200 SUBM E,TEMPX
03300 SUBM D,TEMPY
03400 HRL D,E
03500 PUSHJ P,ARDS
03600 MOVN D,TEMPY
03700 MOVN E,TEMPX
03800 HRL D,E
03900 PUSHJ P,ARDS
04000 POPJ P,
04100 CHRCON: XWD 40,0 ;CONTROL CHARACTER
00100 ;GENERATE ASCII FOR ARDS GRAPHICS
00200 DEFINE CHARD (N,M,P) {
00300 IFE (N-1)*(N-2),<HLRE E,D>
00400 IFE (N-3)*(N-4),<HRRE E,D>
00500 MOVMS E
00600 ASH E,M
00700 IFE (N-1),<TLNE D,400000>
00800 IFE (N-3),<TRNE D,400000>
00900 IFE (N-1)*(N-3),<TRO E,1>
01000 ANDI E,P
01100 IORI E,100
01200 IFE (N-2),<IOR E,CHRCON>
01300 JSR PUTCHR}
01700 ARDS: CHARD 1,1,77
01800 CHARD 2,-5,37
01900 CHARD 3,1,77
02000 CHARD 4,-5,37
02100 POPJ P,
02300 ;INITIALIZE ARDS
02400 ;(INARDS)
02402 INARDS: SETZM ARDBUF ;CLEAR AND RESET BUFFERS
02404 MOVE A,[XWD ARDBUF,ARDBUF+1]
02406 BLT A,PUTCHR-1
02408 MOVE A,[XWD 26,BUF2+1]
02410 MOVEM A,BUF1+1
02412 HRRI A,BUF3+1 ↔ MOVEM A,BUF2+1
02414 HRRI A,BUF1+1 ↔ MOVEM A,BUF3+1
02500 INIT 7,0
02600 SIXBIT/TTY10/
02700 XWD ARDBUF,0
02800 JRST INARD2
02900 MOVE 1,[XWD 400000,BUF1+1]
03000 MOVEM 1,ARDBUF
03100 MOVE 1,[POINT 7,0,35]
03200 MOVEM 1,ARDBUF+1
03300 INARD2: SETZ 1,
03400 POPJ P,
03500 ARDBUF: BLOCK 3
03600 BUF1: 0↔XWD 26,BUF2+1↔BLOCK 30
03700 BUF2: 0↔XWD 26,BUF3+1↔BLOCK 30
03800 BUF3: 0↔XWD 26,BUF1+1↔BLOCK 30
04100 PUTCHR: 0
04200 SOSLE ARDBUF+2
04300 JRST PUTOK
04400 OUTPUT 7,
04500 STATZ 7,740000
04600 HALT
04700 PUTOK: IDPB E,ARDBUF+1
04800 JRST @PUTCHR
00100 ;(PACLST PAC)
00200 PACLST: MOVE C,PACPTR-Q(A)
00300 SETZ G,
00400 SETZ H,
00500 SETZ A,
00600 SKIPN D,PAC(C)
00700 JRST [SKIPE E,PAC+1(C)
00800 JRST [
00900 PCLST0: MOVEI A,Q ;ROW-LIST.
01000 ADD A,G
01100 SETZ B, ;NIL.
01200 CALL 2,CONS
01300 MOVE B,A
01400 MOVEI F,Q
01500 MOVEM F,PCLSTX#
01600 JRST .+3]
01700 PCLST1: CAIN G,107
01800 POPJ P,
01900 AOS G
02000 ADDI C,2
02100 JRST .-1]
02200 MOVE E,PAC+1(C)
02300 JRST PCLST0
02400
02500 EXCH D,E
02600 JFFO E,[EXCH D,E
02700 LSHC D,@F
02800 LSHC D,1
02900 ADDB F,PCLSTX#
02950 AOS PCLSTX
03000 MOVE A,F
03100 CALL 2,CONS
03200 MOVE B,A
03300 JRST .-1]
03400
03500 SKIPE E,D ;CHECK FOR ANY BITS IN 2ND WORD OF ROW.
03600 JRST [SETZ D,
03700 MOVEI F,44
03800 ADDM F,PCLSTX
03900 JRST .-2]
04000
04100 MOVE A,B
04200 MOVE B,H
04300 CALL 2,CONS
04400 MOVE H,A
04500 JRST PCLST1
00100 ;(GREY PAC COLOR XORG YORG)
00200 ;MOVES COLOR INTO PAC FOR GREY LEVEL DISPLAY.
00210 GREYBP: POINT 4,COLORS,8
00220 POINT 4,COLORS,17
00230 POINT 4,COLORS,26
00240 POINT 4,COLORS,35
00300 GREY: MOVE A,PACPAC-Q(A)
00400 MOVE B,GREYBP-Q(B)
00500 INUM C,
00600 INUM D,
00700 IMULI D,110
00800 ADD B,C
00900 ADD B,D
01000 MOVEM AC0 ;SAVE ACCUMULATOR 0.
01100 MOVEI 21
01200 MOVEM AC1 ;OUTER LOOP COUNTER
01300 GREY0: MOVEI 3,21 ;INNER LOOP COUNTER
01400 SETZ 4, ;CLEAR EIGHT ACCUMULATORS
01500 MOVE [XWD 4,5]
01600 BLT 13
01700 GREY1: LDB B
01800 AOS B
01900 JUMPE GREY2 ;MINIMUM INTENSITY CASE.
02000 AOS
02100 CAIE 20
02200 JRST .+6
02300 IORI 5,17 ;MAXIMUM INTENSITY CASE.
02400 IORI 7,17
02500 IORI 11,17
02600 IORI 13,17
02650 JRST GREY2
02700 TRNE 1 ;INTERMEDIATE INTENSITY CASES.
02800 IORI 5,1
02900 TRNE 2
03000 IORI 5,6
03100 TRNE 4
03200 IORI 11,17
03300 TRNN 10
03400 JRST .+3
03500 IORI 7,17
03600 IORI 13,17
03700 GREY2: ROTC 4,4
03800 ROTC 6,4
03900 ROTC 10,4
04000 ROTC 12,4
04100 SOJGE 3,GREY1 ;INNER LOOP.
04200 ROTC 4,-4
04300 ROTC 6,-4
04400 ROTC 10,-4
04500 ROTC 12,-4
04600 MOVE A ;PUT IN PAC
04700 HRLI 4
04900 ADDI A,7
05000 BLT @A
05100 AOS A
05200 SOSGE AC1 ;OUTER LOOP
05300 JRST [MOVE AC0↔SETZ 1,↔POPJ P,]
05400 ADDI B,110-22
05500 JRST GREY0
05600 DEFINE GRYMAC(YY,XX,PAC){
05700 MOVEI A,PAC+Q
05800 MOVE B,AC2
05900 MOVEI C,XX+Q
06000 MOVEI D,YY+Q
06100 PUSHJ P,GREY
06200 }
06300 ;(GRAY N) HIT GREY SIXTEEN TIMES FOR COLOR N AND ALLPAC.
06400 GRAY: MOVEM A,AC2
06500
06600 GRYMAC 0,0,0
06700 GRYMAC 0,22,1
06800 GRYMAC 0,44,2
06900 GRYMAC 0,66,3
07000 GRYMAC 22,0,4
07100 GRYMAC 22,22,5
07200 GRYMAC 22,44,6
07300 GRYMAC 22,66,7
07400 GRYMAC 44,0,10
07500 GRYMAC 44,22,11
07600 GRYMAC 44,44,12
07700 GRYMAC 44,66,13
07800 GRYMAC 66,0,14
07900 GRYMAC 66,22,15
08000 GRYMAC 66,44,16
08100 GRYMAC 66,66,17
08200 POPJ P,
00100 BEGIN TSERVO
00200 A1←1
00300 ;REGISTERS AVAILABLE TO USER
00400 Z←←0
00500
00600 ↑STATUS: Z; STATUS BITS
00700 FLAG: Z; NON-ZERO IF SERVOING
00800 COUNT: Z; LENS CHANGE COUNTER
00900 ↑P1: Z; LATEST POT READING - FOCUS
01000 ↑P2: Z; TILT
01100 ↑P3: Z; PAN
01200 X1: Z; PREVIOUS POT READING
01300 X2: Z
01400 X3: Z
01500 ↑L1: Z; FINAL POT VALUES
01600 ↑L2: Z
01700 ↑L3: Z
01800 E1: 4; TOLERANCES
01900 E2: 10
02000 E3: 10
02100
02200 ;REGISTERS FOR INTERNAL USE ONLY
02300 .DEL: 25; COUNTER FOR HUNG A-D
02400 .MCNT: 300; LENS COUNT
02500 .MCNTX: 240; LENS MOTOR CUTOFF
02600 .MISSD: 100; DATA MISSED COUNT
02700 .CNTR: 40; STOP COUNTER MAX
02800
02900 ;STATUS DITS
03000 .DONE←←1
03100 .RUN←←2
03200 .HUNG←←20
03300 .STOP←←10
03400 .LENS←←4
03500 .MISS←←40
03600
03700 ;RELAY BITS
03800 .P1P←←20000; FOCUS NEAR
03900 .P1M←←10000; FOCUS FAR
04000 .P2M←←400000; TILT UP
04100 .P2P←←200000; TILT DOWN
04200 .P3M←←40000; PAN CW
04300 .P3P←←100000; PAN CCW
04400 .XLENS←←4000
04500 ;CONSTANTS
04600
04700 .AD←←424
04800 .DATA←←204
04900 .MISC←←700
05000 .REL←←40
05100 OPDEF SPCWAR[43B8]
05200
05300 ↑TSERVO: MOVE 17,STATUS; FIXUP STATUS BITS
05400 ANDCMI 17,.HUNG+.MISS
05500 ORI 17,.RUN
05600 SETZM FLAG
05700 SETZM 16;
05800 TRNN 17,.DONE
05900 JRST .LAB1
06000 SETZM COUNT
06100 CONO .MISC,.REL
06200 MOVEM 17,STATUS
06300 CALL
06400
06500 .LAB1: TRZN 17,.LENS
06600 JRST .LAB2
06700 MOVE .MCNT
06800 ADDM COUNT
06900 .LAB2: TRNE 17,.STOP
07000 JRST .LABD
07100 CONI .DATA,1
07200 ANDI 1,7
07300 CONO .DATA,4250
07400 CONO .AD,172000
07500 MOVE 4,.MISSD
07600 MOVE 3,.DEL
07700 CONI .DATA,2
07800 TRNE 2,11000
07900 JRST .+3
08000 SOJG 3,.-3
08100 JRST .HANG
08200 TRNN .DATA,10000
08300 JRST .+3
08400 SOJG 4,.-10
08500 JRST .DMISS
08600 DATAI .DATA,5
08700 CONO .AD,4111
08800 CONO .DATA,203560(1)
08900 ASHC 5,-30
09000 LSH 6,1
09100 ASHC 6,-30
09200 LSH 7,1
09300 ASH 7,-30
09400 MOVE 10,[XWD 5,P1]
09500 BLT 10,P3
09600 SUB 5,L1
09700 SUB 6,L2
09800 SUB 7,L3
09900 MOVM 11,5
10000 MOVM 12,6
10100 MOVM 13,7
10200 CAMGE 11,E1
10300 JRST .LAB3
10400 JUMPG 5,.+2
10500 TROA 16,.P1M
10600 ORI 16,.P1P
10700 SETOM FLAG
10800 .LAB3: CAMGE 12,E2
10900 JRST .LAB4
11000 JUMPG 6,.+2
11100 TROA 16,.P2M
11200 ORI 16,.P2P
11300 SETOM FLAG
11400 .LAB4: CAMGE 13,E3
11500 JRST .LAB5
11600 JUMPG 7,.+2
11700 TROA 16,.P3M
11800 ORI 16,.P3P
11900 JRST .LAB6
12000
12100 .LAB5: SKIPN FLAG
12200 JRST .LABD
12300 .LAB6: MOVS 10,[XWD 5,P1]
12400 BLT 10,7
12500 SUB 5,X1
12600 SUB 6,X2
12700 SUB 7,X3
12800 MOVMS 5
12900 MOVMS 6
13000 MOVMS 7
13100 SUB 5,E1
13200 SUB 6,E2
13300 SUB 7,E3
13400 AND 5,6
13500 AND 5,7
13600 JUMPGE 5,.LAB10
13700 AOS 15,.SCNT
13800 CAMGE 15,.CNTR
13900 JRST .LAB11
14000 SETZM 16
14100 ORI 17,.STOP+.DONE
14200 JRST .+5
14300 .HANG: TROA 17,.HUNG+.DONE
14400 .DMISS: ORI 17,.MISS+.DONE
14500 CONO .AD,4000
14600 CONO .DATA,203560(1)
14700 SETZM COUNT
14800 SETZM .SCNT#
14900 JRST .LABB
15000
15100 .LABD: SKIPN COUNT
15200 ORI 17,.DONE
15300 .LAB10: MOVE 10,[XWD P1,X1]
15400 BLT 10,X3
15500 SETZM .SCNT
15600 .LAB11: MOVE 15,COUNT
15700 CAMLE 15,.MCNTX
15800 ORI 16,.XLENS
15900 .LABB: CONO .MISC,.REL(16)
16000 JUMPLE 15,.+2
16100 SOS COUNT
16200 MOVEM 17,STATUS
16300 CALL
16400
16500 FLUSH: CONO .MISC,.REL
16600 SETOM FL#
16700 CALL
16800 BEND
00100 BEGIN CARCON
00200 P←14
00300 Q←16
00400 QQQ←577777
00500 Z←0
00600 CMD←14
00700 EXTERNAL EXP
00800 OPDEF FIX6 [120B8]
00900 OPDEF FIX [247B8]
01000 ↑HIND: INUM 1,QQQ ↔ MOVEM 1,BKANG ↔JRST CARCAR
01100 ↑FORE: INUM 1,QQQ ↔ MOVEM 1,FRANG ↔JRST CARCAR
01200 ↑HEAD: INUM 1,QQQ ↔ MOVEM 1,CAMANG ↔JRST CARCAR
01300 ↑STOP: SETZM DRCMD ↔JRST CARCAR
01400 ↑RUN: AOS DRCMD ↔JRST CARCAR
01500
01600 CARCAR: SETOM FLAG ↔ SPCWAR 1,CCOMP ↔ SKIPE FLAG ↔ JRST .-1
01700 SPCWAR 636367 ↔ SETZ 1, ↔ POPJ P,
01800
01900 ↑CARCON: SETZM JSTOP
02000 SETOM FLAG
02100 SPCWAR 1,ONCE
02200 SKIPE FLAG
02300 JRST .-1
02400 SPCWAR 636367
02500 SETZ 1,
02600 POPJ P,
02700 FLAG: Z
02800 ONCE: CONO 700,624054 ;STOP THE CART
02900 CONO 700,450050
03000 CONO 700,450055 ;SET UP UNUSED DACS
03100 SETZM DRCMD
03200 SETZM FLAG
03300 CALLI
03400 JSTOP: Z
03500 DISMIS: Z
03600 FRANG: Z
03700 BKANG: Z
03800 CAMANG: Z
03900 DRCMD: Z
04000 BKW51: XWD 51,0
04100 CAM52: XWD 52,0
04200 FRW53: XWD 53,0
04300 DR54: XWD 54,0
04400 VSUP: 9.8
04500 VBE: 0.68
04600 RC: 4.76E-3 ↔ 4.8E-3 ↔ 5.85E-3
04700 CPULS: 1.791E-3
04800 CPMAX: 2.3E-3 ↔ 2.27E-3 ↔ 2.27E-3
04900 EPS: -0.99 ↔ -0.54 ↔ -0.7
05000 PULSW: Z
01200 PULSE: 0 ;CALCULATES DAC VOLTAGE TO MAKE GIVEN WIDTH
01300 MOVE 2,PULSW ;FORMULA IS:
01400 FDV 2,RC(1) ;V(DAC)=2*SUPPLYVOLTAGE+EPSILON-(VSUPPLY-VBE)*E**(PULSW/RC)
01500 JSA Q,EXP
01600 2
01700 MOVE 3,VSUP
01800 FSB 3,VBE
01900 FMP 3,0
02000 MOVE 2,VSUP
02100 FSC 2,1
02200 FAD 2,EPS(1)
02300 FSB 2,3
02400 FMP 2,[102.4] ;MAKES DAC NUMBER FROM VOLTAGE
02500 FIX6 2,233000 ;FIX IT ,THIS LOC IS MODIFIED BY THE PROG.
02600 DPB 2,[POINT 10,BKW51(1),27]
02700 JRST @PULSE
02800
02900
03000
03100
03200
03300 CCOMP: MOVE 2,BKANG ;CCOMP CONTAINS THE ALGORITHM FOR COMPUTING DAC
03400 MOVM 3,2 ;LAST CHECK OF ANGLE
03500 CAILE 3,=360 ;TOO BIG?
03600 MOVEI 2,=360
03700 FSC 2,233 ;FLOAT THE ANGLE
03800 FDV 2,[360.0] ;GET FRACTION OF TOTAL ROTATION
03900 MOVE 3,CPULS ;CENTER WIDTH
04000 FSB 3,CPMAX ;TOTAL DELTA WIDTH
04100 FMP 2,3 ;FOR THIS ANGLE
04200 FAD 2,CPULS ;GET TOTAL WIDTH
04300 MOVEM 2,PULSW
04400 MOVEI 1,0
04500 JSR PULSE
04600 MOVE 2,FRANG ;THIS ROUTINE RUNS IN SPCWAR MODE
04700 MOVM 3,2 ;LAST CHECK OF FRONT
04800 CAILE 3,=360 ;TOO BIG?
04900 MOVEI 2,=360
05000 FSC 2,233 ;FLOAT THE ANGLE
05100 FDV 2,[360.0] ;GET FRACTION OF TOTAL ROTATION
05200 MOVE 3,CPULS ;CENTER WIDTH
00100 FSB 3,CPMAX+2 ;TOTAL DELTA WIDTH
00200 FMP 2,3 ;FOR THIS ANGLE
00300 FAD 2,CPULS ;GET TOTAL WIDTH
00400 MOVEM 2,PULSW
00500 MOVEI 1,2
00600 JSR PULSE
00700 MOVE 2,CAMANG
00800 CAMCK: CAILE 2,=270
00900 JRST CAM1
01000 CAMGE 2,[-=90]
01100 JRST CAM2
01200 MOVEM 2,CAMANG
01300 SUBI 2,=90 ;CHANGE RANGE TO +/-180
01400 MOVM 3,2 ;LAST CHECK ON CAMERA
01500 CAILE 3,=180 ;TOO BIG?
01600 MOVEI 2,=180
01700 FSC 2,233 ;FLOAT THE ANGLE
01800 FDV 2,[180.0] ;GET FRACTION OF TOTAL ROTATION
01900 MOVE 3,CPULS ;CENTER WIDTH
02000 FSB 3,CPMAX+1 ;TOTAL DELTA WIDTH
02100 FMP 2,3 ;FOR THIS ANGLE
02200 FAD 2,CPULS ;GET TOTAL WIDTH
02300 MOVEM 2,PULSW
02400 MOVEI 1,1
02500 JSR PULSE
02600 MOVEI 2,500000 ;HERE CALCULATE DRIVE VOLTAGE
02700 SKIPN DRCMD
02800 ADDI 2,40000 ;DRCMD=1 OR 2 MEANS GO
02900 HRRM 2,DR54
03000 DATAO 700,BKW51
03100 DATAO 700,CAM52
03200 DATAO 700,FRW53
03300 DATAO 700,DR54
03400 SETZM FLAG
03500 CALLI
03600
03700 CAM1: SUBI 2,=180
03800 JRST CAMCK
03900 CAM2: ADDI 2,=180
04000 JRST CAMCK
04100 BEND CARCON